Amiga Collections: Franz PD/Franz PD Disk #067 (1990-04)(Amiga User Group Deutschland e.V.).zip/Franz PD Disk #067 (1990-04)(Amiga User Group Deutschland e.V.).adf/Examples/DeadKeys.p

Text File | 1989-07-02 | 4KB | 190 lines

Program DeadKeys;

{
    This program simply tests the DeadKeyConvert() function,
which in turn exercises the RawKeyConvert() function.  Press keys
with the window that's opened is active, and this program will
print the converted raw keys to the standard output.
}

{$I ":Include/Exec.i" for Forbid, Permit and library things }
{$I ":Include/Ports.i" for the Message stuff }
{$I ":Include/ExecIO.i"}
{$I ":Include/ExecIOUtils.i"}
{$I ":Include/Intuition.i" for window business }
{$I ":Include/InputEvent.i"}
{$I ":Include/ConsoleUtils.i" for Open and CloseConsoleDevice}
{$I ":Include/ConsoleIO.i"}
{$I ":Include/DeadKeyConvert.i" for DeadKeyConvert}

var
    w  : WindowPtr;
    s  : ScreenPtr;

Function OpenTheScreen : Boolean;
var
    ns : NewScreenPtr;
begin
    new(ns);
    with ns^ do begin
    LeftEdge := 0;
    TopEdge  := 0;
    Width    := 640;
    Height   := 200;
    Depth    := 2;
    DetailPen := 3;
    BlockPen  := 2;
    ViewModes := 32768;
    SType     := CUSTOMSCREEN_f;
    Font      := nil;
    DefaultTitle := "Press ESC to End the Demonstration";
    Gadgets   := nil;
    CustomBitMap := nil;
    end;
    s := OpenScreen(ns);
    dispose(ns);
    OpenTheScreen := s <> nil;
end;

Function OpenTheWindow : Boolean;
var
    nw : NewWindowPtr;
begin
    new(nw);
    with nw^ do begin
    LeftEdge := 0;
    TopEdge := 2;
    Width := 640;
    Height := 198;

    DetailPen := -1;
    BlockPen  := -1;
    IDCMPFlags := RAWKEY_f;
    Flags := SMART_REFRESH_f + ACTIVATE_f +
            BORDERLESS_f + BACKDROP_f;
    FirstGadget := Nil;
    CheckMark := Nil;
    Title := "";
    Screen := s;
    BitMap := Nil;
    MinWidth := 0;
    MaxWidth := -1;
    MinHeight := 0;
    MaxHeight := -1;
    WType := CUSTOMSCREEN_f;
    end;

    w := OpenWindow(nw);
    dispose(nw);
    OpenTheWindow := w <> nil;
end;

var
    IMessage    : IntuiMessagePtr;
    Buffer    : Array [0..9] of Char;
    Length    : Integer;
    Leave    : Boolean;
    WriteReq    : IOStdReqPtr;
    WritePort    : MsgPortPtr;

Procedure OpenEverything;
var
    Error : Short;
begin
    OpenConsoleDevice;
    if OpenTheScreen then begin
    if OpenTheWindow then begin
        WritePort := CreatePort(Nil, 0);
        if WritePort <> Nil then begin
        WriteReq := CreateStdIO(WritePort);
        if WriteReq <> Nil then begin
            WriteReq^.ioData := Address(w);
            WriteReq^.ioLength := SizeOf(Window);
            Error := OpenDevice("console.device", 0,
            IORequestPtr(WriteReq), 0);
            if Error = 0 then
            return;
            DeleteStdIO(WriteReq);
            Writeln('Could not open the console.device');
        end else
            Writeln('Could not allocate memory');
        DeletePort(WritePort);
        end else
        Writeln('Could not allocate a message port');
        CloseWindow(w);
    end else
        Writeln('Could not open the window');
    CloseScreen(s);
    end else
    Writeln('Could not open the screen');
    CloseConsoleDevice;
    Exit(20);
end;

Procedure CloseEverything;
begin
    CloseDevice(IORequestPtr(WriteReq));
    DeleteStdIO(WriteReq);
    DeletePort(WritePort);
    CloseWindow(w);
    CloseScreen(s);
    CloseConsoleDevice;
end;

Procedure ConvertControl;
begin
    case Ord(Buffer[0]) of
      8 : ConPutStr(WriteReq, "\b\cP");
     13 : ConPutStr(WriteReq, "\n\cL");
     127 : ConPutStr(WriteReq, "\cP");
    else
    ConPutChar(WriteReq, Buffer[0]);
    end;
end;

Procedure ConvertTwoChar;
begin
    case Buffer[1] of
      'A'..'D' : ConWrite(WriteReq, Adr(Buffer), 2);
    end;
end;

begin
    OpenEverything;
    Leave := False;
    repeat
    IMessage := IntuiMessagePtr(WaitPort(w^.UserPort));
    IMessage := IntuiMessagePtr(GetMsg(w^.UserPort));
    if IMessage^.Class = RAWKEY_f then begin
        if IMessage^.Code < 128 then begin { Key Down }
        Length := DeadKeyConvert(IMessage, Adr(Buffer), 10, Nil);
        case Length of
          -MaxInt..-1 : Writeln('DeadKeyConvert error ', Length);
           1 : if Buffer[0] = '\e' then
               Leave := True
            else begin
                if (Buffer[0] < ' ') or
                (Ord(Buffer[0]) > 126) then
                ConvertControl
                else begin
                Buffer[2] := Buffer[0];
                Buffer[0] := '\c';
                Buffer[1] := '@'; { Insert }
                ConWrite(WriteReq, Adr(Buffer), 3);
                end;
            end;
           2 : ConvertTwoChar;
        end;
        end;
    end else
        Leave := True;
    ReplyMsg(MessagePtr(IMessage));
    until Leave;
    Forbid;
    repeat
    IMessage := IntuiMessagePtr(GetMsg(w^.UserPort));
    until IMessage = nil;
    Permit;
    CloseEverything;
end.